perm filename DPY.F4[PIC,LCS] blob sn#525280 filedate 1982-01-09 generic text, type T, neo UTF8
	SUBROUTINE DPY
	COMMON/D/ JD(4000),I(3,40000)
	COMMON NAME
2	FORMAT(4I)
4	FORMAT(' 0=SEE NEXT DPY UNIT;  99=EXIT;  OR X-Y SHIFT. '$)
	JJ=0
	KK=0
CC	MM=1
CC	NN=1
C6 	CALL IFILE(22,NAME)
6	N=0
50	KNT=0
	TYPE 2,(I(NX,N+1),NX=1,3)
C TYPE 1ST X-Y COORDS.
	CALL DPYSET(1,JD,4000)
	CALL DPYCLR
C1	READ(22,2,END=99)N,(I(K,N),K=1,3)
1	N=N+1
	NZ=I(3,N)
	IF(NZ.GT.1)GO TO 1
	IF(NZ)GO TO 99
C -1 IN 3RD SLOT=END
	NX=JJ+I(1,N)
	NY=KK+I(2,N)
	KNT=KNT+1
	IF(KNT.GT.3900)GO TO 99
	IF(NZ.NE.0)GO TO 3
7	CALL AVECT(NX,NY)
	GO TO 1
3	CALL AIVECT(NX,NY)
	GO TO 1
99	CALL DPYOUT(1)
	TYPE 4
	ACCEPT 2,JJ,KK
	IF(JJ.EQ.0)GO TO 50
	IF(JJ.EQ.99)RETURN
	GO TO 6
	END

	SUBROUTINE NNO(NN)
	IF(NN.LT.39999)GO TO 2 
	TYPE 1
1	FORMAT(' TOO MANY POINTS')
	RETURN
2	NN=NN+1
	END

 	SUBROUTINE SHFT(II,JIN,NX)
	COMMON NMOUT/OUTER/LFT,RT,TOP,BOT
	INTEGER LFT,RT,TOP,BOT
	COMMON  /JJJJ/JP,KP,XS,YS
	DIMENSION II(4),JIN(3,1000)
	NX=NX+1
	II(1)=NX
	K=JP+(JIN(1,NX)*XS+.5)
	IF(K.GT.RT)RT=K
	IF(K.LT.LFT)LFT=K
	II(2)=K
	K=KP+(JIN(2,NX)*YS+.5)
	IF(K.GT.TOP)TOP=K
	IF(K.LT.BOT)BOT=K
	II(3)=K
	II(4)=JIN(3,NX)
	END